(*******************************************************************
This file is part of Geomancian.

Geomancian is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

Geomancian is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with Geomancian.  If not, see <http://www.gnu.org/licenses/>.
********************************************************************)

open Printf
open Figures
exception Bad_Input
exception OH_NOES

(**********************************
 * Global configuration settings. *
 **********************************)
(* General settings. *)
let verbalInput = ref false
let saveFile = ref ""
let fout = ref stdout
let gcpo = ref false
let showVersion = ref false
let getQuerentInfo = ref false
let promptInputs = ref true
let showBothCharts = ref false
let showEverything = ref false
let showSettings = ref false

(* Geomantic chart settings. *)
let displayGeo = ref true
let displayGeoTriads = ref false
let displayGeoTableau = ref false
let displayMoreTriads = ref false 
let evolveTriads = ref false
let displayGeoInfo = ref false
let displayGeoTableauFull = ref false
	
(* Astrological chart settings. *)
let displayAstro = ref false
let displayAstroInfo = ref false
let displayAstroTableau = ref false
let displayTimeline = ref false 
let displayRulerships = ref false
let displayAstroCourt = ref false
let displaySignfs = ref false 
let houseSystem = ref "trad"
let zodiacSystem = ref "gerard"
let significator = ref 0
let rotation = ref 0

(**********************
 * Utility functions. *
 **********************)
(* Get the index of an item in a list. -1 if it's not in the list. *)
let get_list_index list e = begin
	let i = ref (-1) in
	for j = 0 to (pred (List.length list)) do
		if List.nth list j = e then i := j
	done ;		
	!i
end

(* Convert a string consisting of binary 0s and 1s to a figure. *)
let figure_of_binary_string s = begin
	if String.length s <> 4 then raise Bad_Input ;
	if String.contains s '0' && String.contains s '2' then raise Bad_Input ;
	String.iter (fun c ->
		if not (c = '0' || c = '1' || c = '2') then raise Bad_Input
	) s ;
	begin try 
		while true do
			let i = String.index s '2' in
			String.set s i '0'
		done
	with _ -> () end ;
	{
		head	= int_of_string (String.make 1 s.[0]) ;
		neck	= int_of_string (String.make 1 s.[1]) ;
		body	= int_of_string (String.make 1 s.[2]) ;
		feet 	= int_of_string (String.make 1 s.[3])  
	}
end

(* Get the actual name of a figure. *)
let get_figure_name f = (find_figure zodiac f).name

(* Convert a number 1 through 12/0 to Roman numerals I to XII. *)
let roman_of_int n = match n with
    | 0 -> "XII"
    | 1 -> "I"
	| 2 -> "II"
	| 3 -> "III"
	| 4 -> "IV"
	| 5 -> "V"
	| 6 -> "VI"
	| 7 -> "VII"
	| 8 -> "VIII"
	| 9 -> "IX"
	| 10 -> "X"
	| 11 -> "XI"
	| 12 -> "XII"
	| _ -> raise OH_NOES

(* Get the four Mothers from stdin. *)
let rec form_mothers () = begin
	if not !verbalInput
	then begin
		printf "Please enter the binary representation of the four Mother figures.\n" ;
		try
			printf "First Mother:  " ;
			let m1 = figure_of_binary_string (read_line ()) in
			printf "Second Mother: " ;
			let m2 = figure_of_binary_string (read_line ()) in
			printf "Third Mother:  " ;
			let m3 = figure_of_binary_string (read_line ()) in
			printf "Fourth Mother: " ;
			let m4 = figure_of_binary_string (read_line ()) in	
			printf "\n" ; 
			m1, m2, m3, m4
		with _ -> printf "Bad input!  Please try again.\n" ; form_mothers ()
	end
	else begin
		printf "Please enter the names of the four Mother figures.\n" ;
		try
			printf "First Mother:  " ;
			let m1 = (find_figure_name zodiac (read_line ())).figure in
			printf "Second Mother: " ;
			let m2 = (find_figure_name zodiac (read_line ())).figure in
			printf "Third Mother:  " ;
			let m3 = (find_figure_name zodiac (read_line ())).figure in
			printf "Fourth Mother: " ;
			let m4 = (find_figure_name zodiac (read_line ())).figure in
			printf "\n" ; 
			m1, m2, m3, m4
		with _ -> printf "Bad input!  Please try again.\n" ; form_mothers ()
	end
end

(* Form the four Daughters by interrelating the points. *)
let form_daughters m1 m2 m3 m4 =
	{
		head = m1.head ;
        neck = m2.head ;
		body = m3.head ;
        feet = m4.head
	}, {
		head = m1.neck ;
        neck = m2.neck ;
		body = m3.neck ;
        feet = m4.neck
	}, {
		head = m1.body ;
        neck = m2.body ;
		body = m3.body ;
        feet = m4.body
	}, {
		head = m1.feet ; 
        neck = m2.feet ;
		body = m3.feet ; 
        feet = m4.feet
	}
	
(* Form the four Nieces by adding the Mothers and Daughters. *)
let form_nieces m1 m2 m3 m4 d1 d2 d3 d4 = 
	(add m1 m2), 
	(add m3 m4), 
	(add d1 d2), 
	(add d3 d4) 
	
(* Form the Court by adding the Nieces, Courtiers, and the First Mother. *)
let form_court n1 n2 n3 n4 m1 = 
    let rw = add n1 n2 in
	let lw = add n3 n4 in
	let j = add rw lw in
	rw, lw, j, (add j m1)

(**************************
 * Calculation functions. *
 **************************)	
(* Form the sum of the sixteen geomantic figures. *)
let get_sum l =
	let sum = ref 0 in
	List.iter (fun f ->
		let gf = find_figure zodiac f in
		sum := !sum + gf.sum ) l ;
	!sum

(* Find the index of the chart. *)
let calc_index m d n = 
	let index = ref 0 in
	List.iter (fun f ->
		if f.head = 1 then index := succ !index ;
		if f.neck = 1 then index := succ !index ;
		if f.body = 1 then index := succ !index ;
		if f.feet = 1 then index := succ !index ;
	) m ;
	List.iter (fun f ->
		if f.head = 1 then index := succ !index ;
		if f.neck = 1 then index := succ !index ;
		if f.body = 1 then index := succ !index ;
		if f.feet = 1 then index := succ !index ;
	) d ;
	List.iter (fun f ->
		if f.head = 1 then index := succ !index ;
		if f.neck = 1 then index := succ !index ;
		if f.body = 1 then index := succ !index ;
		if f.feet = 1 then index := succ !index ;
	) n ;
    if !index mod 12 = 0 then 12 else !index mod 12

(* Find the Pars Fortunae of the chart. *)
let calc_pars_fortunae m d n = 
	let index = ref 0 in
	List.iter (fun f ->
		if f.head = 1 then index := succ !index else index := !index + 2 ;
		if f.neck = 1 then index := succ !index else index := !index + 2 ;
		if f.body = 1 then index := succ !index else index := !index + 2 ;
		if f.feet = 1 then index := succ !index else index := !index + 2 ;
	) m ;
	List.iter (fun f ->
		if f.head = 1 then index := succ !index else index := !index + 2 ;
		if f.neck = 1 then index := succ !index else index := !index + 2 ;
		if f.body = 1 then index := succ !index else index := !index + 2 ;
		if f.feet = 1 then index := succ !index else index := !index + 2 ;
	) d ;
	List.iter (fun f ->
		if f.head = 1 then index := succ !index else index := !index + 2 ;
		if f.neck = 1 then index := succ !index else index := !index + 2 ;
		if f.body = 1 then index := succ !index else index := !index + 2 ;
		if f.feet = 1 then index := succ !index else index := !index + 2 ;
	) n ;
    if !index mod 12 = 0 then 12 else !index mod 12

(* Find the root causes by the Via Puncti, or the Way of the Points. *)
let calc_via_puncti m d n c = 
	let separate_bunch l = match l with
		| f1 :: f2 :: f3 :: f4 :: [] -> f1, f2, f3, f4
		| _ -> raise OH_NOES
	in
	let m1, m2, m3, m4 = separate_bunch m in
	let d1, d2, d3, d4 = separate_bunch d in
	let n1, n2, n3, n4 = separate_bunch n in
	let rw, lw, j, s = separate_bunch c in

	let head = j.head in
	let causes = ref [] in
	if head = rw.head
	then begin
		if head = n1.head 
		then begin
			if head = m1.head
			then causes := (m1, "First Mother") :: !causes ;
			if head = m2.head
			then causes := (m2, "Second Mother") :: !causes ;
			if head <> m1.head && head <> m2.head
			then causes := (n1, "First Niece") :: !causes
		end ;
		if head = n2.head
		then begin
			if head = m3.head
			then causes := (m3, "Third Mother") :: !causes ;
			if head = m4.head
			then causes := (m4, "Fourth Mother") :: !causes ;
			if head <> m3.head && head <> m4.head
			then causes := (n2, "Second Niece") :: !causes
		end ;
		if head <> n1.head && head <> n2.head
		then causes := (rw, "Right Witness") :: !causes
	end ;
	if head = lw.head
	then begin
		if head = n3.head 
		then begin
			if head = d1.head
			then causes := (d1, "First Daughter") :: !causes ;
			if head = d2.head
			then causes := (d2, "Second Daughter") :: !causes ;
			if head <> d1.head && head <> d2.head
			then causes := (n3, "Third Niece") :: !causes
		end ;
		if head = n4.head 
		then begin
			if head = d3.head
			then causes := (d3, "Third Daughter") :: !causes ;
			if head = d4.head
			then causes := (d4, "Fourth Daughter") :: !causes ;
			if head <> d3.head && head <> d4.head
			then causes := (n4, "Fourth Niece") :: !causes

		end ;
		if head <> n4.head && head <> n3.head
		then causes := (lw, "Left Witness") :: !causes
	end ;
	List.rev !causes
	
(* Allocate the figures to the houses accordingly. Rotate the houses as 
 * necessary as per the rotation setting.  *)
let allocateHouses m d n = begin
	if !houseSystem <> "trad" &&
		!houseSystem <> "eso" &&
		!houseSystem <> "gd"
	then houseSystem := "trad" ;
	
	let order = ref [] in
	if !houseSystem = "trad"
	then order := List.concat [ m ; d ; n ] ;
	if !houseSystem = "eso"
	then order := [
		List.nth m 0 ; List.nth d 0 ; List.nth n 0 ; 
		List.nth m 1 ; List.nth d 1 ; List.nth n 1 ; 
		List.nth m 2 ; List.nth d 2 ; List.nth n 2 ; 
		List.nth m 3 ; List.nth d 3 ; List.nth n 3 ] ;
	if !houseSystem = "gd"
	then order := [
		List.nth m 1 ; List.nth d 1 ; List.nth n 1 ; 
		List.nth m 2 ; List.nth d 2 ; List.nth n 2 ; 
		List.nth m 3 ; List.nth d 3 ; List.nth n 3 ; 
		List.nth m 0 ; List.nth d 0 ; List.nth n 0 ] ;
	
	if !rotation < 2 || !rotation > 12
	then rotation := 0 ;
	let passed = ref [] in
	for i = 0 to pred (pred !rotation) do
		let hd = List.hd !order in
		let tl = List.tl !order in
		passed := hd :: !passed ;
		order := tl
	done ;
	order := !order @ (List.rev !passed) ;
	!order
end

(* Get the proper order of the zodiac starting with the figure in House 1, 
 * according to Gerard of Cremona or Agrippa. *)
let getZodiac m d n abbreviated = begin
	let getMySign f =
		begin match !zodiacSystem with
		| "gerard"	-> (find_figure zodiac f).gerardZ
		| "agrippa"	-> (find_figure zodiac f).agrippaZ
		| "aries"	-> "Aries"
		| _ -> raise OH_NOES end ;
	in

	let signs = Queue.create () in
	if not abbreviated then begin
		Queue.add "Aries" signs ;		
        Queue.add "Taurus" signs ;	
		Queue.add "Gemini" signs ;		
        Queue.add "Cancer" signs ;	
		Queue.add "Leo" signs ;			
        Queue.add "Virgo" signs ;	
		Queue.add "Libra" signs ;		
        Queue.add "Scorpio" signs ;	
		Queue.add "Sagittarius" signs ;	
        Queue.add "Capricorn" signs ; 	
		Queue.add "Aquarius" signs ;	
        Queue.add "Pisces" signs	
	end 
	else begin
		Queue.add "Ari" signs ;	
        Queue.add "Tau" signs ;
		Queue.add "Gem" signs ;	
        Queue.add "Can" signs ;	
		Queue.add "Leo" signs ;	
        Queue.add "Vir" signs ;	
		Queue.add "Lib" signs ;	
        Queue.add "Sco" signs ;	
		Queue.add "Sag" signs ;	
        Queue.add "Cap" signs ; 
		Queue.add "Aqu" signs ;	
        Queue.add "Pis" signs
	end ;
	let order = allocateHouses m d n in
	let asc = if not abbreviated
		then getMySign (List.nth order 0)
		else String.sub (getMySign (List.nth order 0)) 0 3
	in
	let doneLooking = ref false in
	while not !doneLooking do
		let f = Queue.peek signs in
		if f = asc 
		then doneLooking := true
		else Queue.push (Queue.pop signs) signs
	done ;
	
	let myOrder = ref [] in
	Queue.iter (fun f ->
		myOrder := f :: !myOrder
	) signs;
	
	List.rev !myOrder
end	

(* Find company between the houses. *)
let getCompany m d n = begin
	let order = allocateHouses m d n in
	let company = ref [] in
	for i = 0 to 5 do
		let oddF = find_figure zodiac (List.nth order (2*i)) in
		let evenF = find_figure zodiac (List.nth order (2*i + 1)) in
		let kind = ref "" in
		
		if oddF.figure.head = evenF.figure.head
		then kind := "capitular" ;
		if (revert oddF.figure) = evenF.figure 
		then kind := "compound" ;
		if oddF.planet = evenF.planet
		then kind := "demisimple" ;
		if oddF = evenF
		then kind := "simple" ;
		
		if !kind <> ""
		then begin
			let add = (find_figure zodiac (add 
				(List.nth order (2*i))
				(List.nth order (2*i + 1)))).name in
			company := (2*i + 1, !kind, add) :: !company
		end
	done ;
	List.rev !company
end

(***********************************************************
 * Build the hashtable and stuff for looking up dignities. *
 ***********************************************************)
let dignities = (Hashtbl.create 37)
let domicile    = 0
let exile       = 1  
let exaltation  = 2  
let detriment   = 3 

let build_dignity_table () = begin
	Hashtbl.add dignities (pop.figure, "house") ([10], [8], [3], [], []) ;
	Hashtbl.add dignities (via.figure, "house") ([3;5;7], [11], [3], [], []) ;
	Hashtbl.add dignities (fma.figure, "house") ([1;5;6;11], [7], [9], [], []) ;
	Hashtbl.add dignities (fmi.figure, "house") ([8;2], [], [9], [], []) ;
	Hashtbl.add dignities (pla.figure, "house") ([5;7], [4], [5], [], []) ;
	Hashtbl.add dignities (ami.figure, "house") ([8], [2], [5], [], []) ;
	Hashtbl.add dignities (car.figure, "house") ([4], [6;7;8;12], [12], [], []) ;
	Hashtbl.add dignities (tri.figure, "house") ([], [1;2;3;5;6;7;9;10;11;12], [12], [], []) ;
	Hashtbl.add dignities (con.figure, "house") ([7;9;10], [8;12], [1], [], []) ;
	Hashtbl.add dignities (alb.figure, "house") ([4], [1], [1], [], []) ;
	Hashtbl.add dignities (pur.figure, "house") ([3], [5], [6], [], []) ;
	Hashtbl.add dignities (rub.figure, "house") ([8], [2;4;7], [6], [], []) ;
	Hashtbl.add dignities (acq.figure, "house") ([1;2;10], [7;8], [11], [], []) ;
	Hashtbl.add dignities (lae.figure, "house") ([5], [6;8;12], [11], [], []) ;
	Hashtbl.add dignities (cad.figure, "house") ([6;9;12], [2;4;11], [6;12], [], []) ;
	Hashtbl.add dignities (ctd.figure, "house") ([2;7], [12], [5;11], [], []) ;

	Hashtbl.add dignities (pop.figure, "sign") ([4], [10], [2], [8], [12]) ;
	Hashtbl.add dignities (via.figure, "sign") ([4], [10], [2], [8], [12]) ;
	Hashtbl.add dignities (fma.figure, "sign") ([5], [11], [1], [7], [9]) ;
	Hashtbl.add dignities (fmi.figure, "sign") ([5], [11], [1], [7], [9]) ;
	Hashtbl.add dignities (pla.figure, "sign") ([7], [1], [12], [6], [3;11]) ;
	Hashtbl.add dignities (ami.figure, "sign") ([2], [8], [3], [9], [10;6]) ;
	Hashtbl.add dignities (car.figure, "sign") ([10], [4], [7], [1], [2;6]) ;
	Hashtbl.add dignities (tri.figure, "sign") ([11], [5], [8], [2], [7;3]) ;
	Hashtbl.add dignities (con.figure, "sign") ([6], [12], [9], [3], [2;10]) ;
	Hashtbl.add dignities (alb.figure, "sign") ([3], [9], [6], [12], [7;11]) ;
	Hashtbl.add dignities (pur.figure, "sign") ([1], [7], [10], [4], [5;9]) ;
	Hashtbl.add dignities (rub.figure, "sign") ([8], [2], [5], [11], [4;12]) ;
	Hashtbl.add dignities (acq.figure, "sign") ([9], [3], [4], [10], [1;5]) ;
	Hashtbl.add dignities (lae.figure, "sign") ([12], [6], [11], [5], [4;8]) ;
	Hashtbl.add dignities (cad.figure, "sign") ([], [], [], [], []) ;
	Hashtbl.add dignities (ctd.figure, "sign") ([], [], [], [], []) ;
end

let getRuler f hoSi id = begin
	let rul, exi, exn, det, tri = Hashtbl.find dignities (f, hoSi) in
	let ret = ref "" in
	if hoSi = "house" 
	then begin
		if List.mem id exn then ret := !ret ^ "2x " ;
		if List.mem id rul then ret := !ret ^ "Favorable" ;
		if List.mem id exi then ret := !ret ^ "Unfavorable" ;
	end
	else begin
		if List.mem id exi then ret := "Exiled" ;
		if List.mem id det then ret := "Fallen" ;
		if List.mem id tri then ret := "Triplicity" ;
		if List.mem id exn then ret := "Exalted" ;
		if List.mem id rul then ret := "Ruler" ;
	end ;
	!ret
end

let getShortPlanet f = begin
	let gf = find_figure zodiac f in
	let pl = gf.planet in
	let plm = match gf.planetMod with
		| "retrograde" -> "Rx"
		| "in northern declination" -> "N. Dec"
		| "in southern declination" -> "S. Dec"
		| "direct" -> ""
		| _ -> gf.planetMod
	in
	pl ^ " " ^ plm
end



(**********************
 * Display functions. *
 **********************)
(* Display the tableau. *)
let print_geo_chart m d n c = begin
	fprintf !fout "
+---------------------+
|  Geomantic Tableau  |
+---------------------+
\n" ;
	let num = ref 1 in
	let all = List.concat [ m ; d ; n ; c ] in
	List.iter2 (fun p f ->
		fprintf !fout "%-16s%15s%s\n"
		(p ^ ":")
		(get_figure_name f)
		(if !displayGeoInfo
			then " (" ^ (find_figure zodiac f).mobility ^ " and " ^ (find_figure zodiac f).iElement ^ ")"
			else "" ) ;
		if !num mod 4 = 0 && !num < 15 then fprintf !fout "\n" ; num := !num + 1		
	) tPositions all ;
end

let print_gcpo_chart m d n c = begin
	let num = ref 1 in
	let all = List.concat [ m ; d ; n ; c ] in
	List.iter2 (fun p f ->
		fprintf !fout "%s: %s\n" p (get_figure_name f) ;
		num := !num + 1		
	) tShortPositions all ;
end

let print_via_puncti m d n c = begin
    let causes = calc_via_puncti m d n c in
    if List.length causes = 0 
    then fprintf !fout "The Via Puncti cannot be formed."
    else fprintf !fout "The Via Puncti points to " ;	
    let n = pred (List.length causes) in	
    for i = 0 to n do
        let f, s = List.nth causes i in
        if i = n && n >= 1 then fprintf !fout "and " ;
        fprintf !fout "%s (the %s)" (get_figure_name f) s ;
        if i < n
        then fprintf !fout ", "
        else fprintf !fout "."
    done
end

(* Display the geomantic tableau information. *)
let print_geo_info m d n c all = begin
		fprintf !fout "
+---------------------------------+
|  Geomantic Tableau Information  |
+---------------------------------+
\n" ;

		let j = find_figure zodiac (List.nth c 2) in
		fprintf !fout "The Judge is %s, a %s figure.\n" j.name j.mobility ; 
		
		(*
		 * Calculate the sum of the sixteen figures.
		 *) 
		let sum = get_sum all in
		fprintf !fout "The sum of the tableau is %i, an " sum ;
		if sum mod 2 = 0
		then fprintf !fout "even number.\n"
		else fprintf !fout "odd number.\n" ;
	
		(*
		 * Calculate the Index, or the Part of Fortune.
		 *)
		let index = calc_index m d n in
		let i = ref index in
		if index = 0 then i := 12 ;
		fprintf !fout "The Index is %i, %s, the %s.\n"
			!i
			(get_figure_name (List.nth all (!i-1)))
			(List.nth tPositions (!i-1)) ;
	
		(*
		 * Calculate the Via Puncti, or the Way of the Points.
		 *)
        print_via_puncti m d n c ;
        fprintf !fout "\n"
end

(* Display the triads. *)
let print_triads m d n c = begin
	fprintf !fout "
+--------------------+
|  Geomantic Triads  |
+--------------------+
\n";
	if !evolveTriads 
	then begin
		fprintf !fout "Triad I   : %s -> %s -> %s\n" 
			(get_figure_name (List.nth m 0))
			(get_figure_name (List.nth n 0))
			(get_figure_name (List.nth m 1)) ;
		fprintf !fout "Triad II  : %s -> %s -> %s\n"
			(get_figure_name (List.nth m 2))
			(get_figure_name (List.nth n 1))
			(get_figure_name (List.nth m 3)) ;
		fprintf !fout "Triad III : %s -> %s -> %s\n"
			(get_figure_name (List.nth d 0))
			(get_figure_name (List.nth n 2))
			(get_figure_name (List.nth d 1)) ;
		fprintf !fout "Triad IV  : %s -> %s -> %s\n"
			(get_figure_name (List.nth d 2))
			(get_figure_name (List.nth n 3))
			(get_figure_name (List.nth d 3)) ;
		if !displayMoreTriads 
		then begin
			fprintf !fout "\nTriad V   : %s -> %s -> %s\n"
				(get_figure_name (List.nth n 0))
				(get_figure_name (List.nth c 0))
				(get_figure_name (List.nth n 1)) ;
			fprintf !fout "Triad VI  : %s -> %s -> %s\n"
				(get_figure_name (List.nth n 2))
				(get_figure_name (List.nth c 1))
				(get_figure_name (List.nth n 3)) ;
			fprintf !fout "Triad VII : %s -> %s -> %s\n"
				(get_figure_name (List.nth c 0))
				(get_figure_name (List.nth c 2))
				(get_figure_name (List.nth c 1)) ;
			fprintf !fout "Triad VIII: %s -> %s -> %s\n"
				(get_figure_name (List.nth c 2))
				(get_figure_name (List.nth c 3))
				(get_figure_name (List.nth m 1))
		end
	end
	else begin
		fprintf !fout "Triad I   : %s + %s = %s\n" 
			(get_figure_name (List.nth m 0))
			(get_figure_name (List.nth m 1))
			(get_figure_name (List.nth n 0)) ;
		fprintf !fout "Triad II  : %s + %s = %s\n"
			(get_figure_name (List.nth m 2))
			(get_figure_name (List.nth m 3))
			(get_figure_name (List.nth n 1)) ;
		fprintf !fout "Triad III : %s + %s = %s\n"
			(get_figure_name (List.nth d 0))
			(get_figure_name (List.nth d 1))
			(get_figure_name (List.nth n 2)) ;
		fprintf !fout "Triad IV  : %s + %s = %s\n"
			(get_figure_name (List.nth d 2))
			(get_figure_name (List.nth d 3))
			(get_figure_name (List.nth n 3)) ;
		if !displayMoreTriads 
		then begin
			fprintf !fout "\nTriad V   : %s + %s = %s\n"
				(get_figure_name (List.nth n 0))
				(get_figure_name (List.nth n 1)) 
				(get_figure_name (List.nth c 0)) ;
			fprintf !fout "Triad VI  : %s + %s = %s\n"
				(get_figure_name (List.nth n 2))
				(get_figure_name (List.nth n 3)) 
				(get_figure_name (List.nth c 1)) ;
			fprintf !fout "Triad VII : %s + %s = %s\n"
				(get_figure_name (List.nth c 0))
				(get_figure_name (List.nth c 1))
				(get_figure_name (List.nth c 2)) ;
			fprintf !fout "Triad VIII: %s + %s = %s\n"
				(get_figure_name (List.nth m 0))
				(get_figure_name (List.nth c 2))
				(get_figure_name (List.nth c 3))
		end
	end			
end

(* Print out a graphical tableau as ASCII. *)
let print_geo_tableau m d n c = begin
	fprintf !fout "
+---------------------+
|  Geomantic Tableau  |
+---------------------+\n" ;
	let all = List.concat [m ; d ; n ; c] in

	let i = ref (calc_index m d n) in
	if !i = 0 then i := 12 ;

	let getStar l n = begin
		if l = 0 
		then begin 
			if n = pred !i && !displayGeoTableauFull
			then "# #"
			else "* *" 
		end
		else begin 
			if n = pred !i && !displayGeoTableauFull
			then " # "
			else " * "
		end
	end in

	let causes = calc_via_puncti m d n c in
	let path = ref [] in
	List.iter (fun t ->
		let f, s = t in
		let i = get_list_index tPositions s in
		let add = ref [] in 
		if i = 1 || i = 0 then add := i :: 8 :: 12 :: !add ;
		if i = 3 || i = 2 then add := i :: 9 :: 12 ::!add ;
		if i = 5 || i = 4 then add := i :: 10 :: 13 ::!add ;
		if i = 7 || i = 6 then add := i :: 11 :: 13 :: !add ;
		if i = 9 || i = 8 then add := i :: 12 :: !add ;
		if i = 11 || i = 10 then add := i :: 13 :: !add ;
		if i = 12 then add := i :: !add ;
		if i = 13 then add := i :: !add ;
		path := !add @ !path ;
	) causes ;

	fprintf !fout "
o-----+-----+-----+-----+-----+-----+-----+-----o
|     |     |     |     |     |     |     |     |
|" ; 
	for i = 7 downto 0 do
		let str = getStar (List.nth all i).head i in
		fprintf !fout " %s |" str 
	done ; 
	fprintf !fout "\n|" ;
	for i = 7 downto 0 do
		let str = getStar (List.nth all i).neck i in
		fprintf !fout " %s |" str 
	done ;
	fprintf !fout "\n|" ;
	for i = 7 downto 0 do
		let str = getStar (List.nth all i).body i in
		fprintf !fout " %s |" str 
	done ;
	fprintf !fout "\n|" ;
	for i = 7 downto 0 do
		let str = getStar (List.nth all i).feet i in
		fprintf !fout " %s |" str 
	done ;
	fprintf !fout "
|     |     |     |     |     |     |     |     |
+" ;
	
	for i = 7 downto 0 do
		if List.mem i !path && !displayGeoTableauFull
		then fprintf !fout "-/|\\-+" 
		else fprintf !fout "-----+" 
	done ;

fprintf !fout "
|           |           |           |           |
|" ;
	for i = 11 downto 8 do
		let str = getStar (List.nth all i).head i in
		fprintf !fout "    %s    |" str 
	done ; 
	fprintf !fout "\n|" ;
	for i = 11 downto 8 do
		let str = getStar (List.nth all i).neck i in
		fprintf !fout "    %s    |" str 
	done ; 
	fprintf !fout "\n|" ;
	for i = 11 downto 8 do
		let str = getStar (List.nth all i).body i in
		fprintf !fout "    %s    |" str 
	done ; 
	fprintf !fout "\n|" ;
	for i = 11 downto 8 do
		let str = getStar (List.nth all i).feet i in
		fprintf !fout "    %s    |" str 
	done ; 
	fprintf !fout "
|           |           |           |           |
+" ;

	for i = 11 downto 8 do
		if List.mem i !path && !displayGeoTableauFull
		then fprintf !fout "----/|\\----+" 
		else fprintf !fout "-----------+" 
	done ;

	fprintf !fout "
|                       |                       |
|" ;
	for i = 13 downto 12 do
		let str = getStar (List.nth all i).head i in
		fprintf !fout "          %s          |" str 
	done ; 
	fprintf !fout "\n|" ;
	for i = 13 downto 12 do
		let str = getStar (List.nth all i).neck i in
		fprintf !fout "          %s          |" str 
	done ; 
	fprintf !fout "\n|" ;
	for i = 13 downto 12 do
		let str = getStar (List.nth all i).body i in
		fprintf !fout "          %s          |" str 
	done ; 
	fprintf !fout "\n|" ;
	for i = 13 downto 12 do
		let str = getStar (List.nth all i).feet i in
		fprintf !fout "          %s          |" str 
	done ; 
	fprintf !fout "
|                       |                       |
+" ;

	for i = 13 downto 12 do
		if List.mem i !path && !displayGeoTableauFull
		then fprintf !fout "----------/|\\----------+" 
		else fprintf !fout "-----------------------+" 
	done ;

	if !displayGeoTableauFull
	then begin
		fprintf !fout "-----o
|                                               |     |
" 	;
	let j = List.nth all 14 in
	let s = List.nth all 15 in
	let star i = (if i = 0 then "* *" else " * ") in
	fprintf !fout "|                      %s                      | %s |\n"
		(star j.head) (star s.head) ;
	fprintf !fout "|                      %s                      | %s |\n"
		(star j.neck) (star s.neck) ;
	fprintf !fout "|                      %s                      | %s |\n"
		(star j.body) (star s.body) ;
	fprintf !fout "|                      %s                      | %s |"
		(star j.feet) (star s.feet) ;
	fprintf !fout "
|                                               |     |
o-----------------------------------------------+-----o\n"

	end
	else begin
		fprintf !fout "
|                                               |
" ;
	let j = List.nth all 14 in
	let star i = (if i = 0 then "* *" else " * ") in
	fprintf !fout "|                      %s                      |\n"
		(star j.head) ;
	fprintf !fout "|                      %s                      |\n"
		(star j.neck) ;
	fprintf !fout "|                      %s                      |\n"
		(star j.body) ;
	fprintf !fout "|                      %s                      |"
		(star j.feet) ;
	fprintf !fout "
|                                               |
o-----------------------------------------------o\n"
	end
end

let get_full_planet f = begin
	let gf = find_figure zodiac f in
	if gf.planetMod <> ""
	then gf.planet ^" "^ gf.planetMod
	else gf.planet
end

let print_house order zod i = begin
	let l = ["Angular" ; "Succedent" ; "Cadent"] in
    if !displayAstroInfo
    then fprintf !fout "%9s House %-5s %14s (%s in %s)\n"
        (List.nth l (i mod 3))
        ((roman_of_int (i+1)) ^ ":")
        (get_figure_name (List.nth order i))
        (get_full_planet (List.nth order i))
        (List.nth zod i)
    else fprintf !fout "House %-5s %14s\n"
       ((roman_of_int (i+1)) ^ ":")
       (get_figure_name (List.nth order i))
end 

(* Print the houses. *)
let print_astro_chart m d n = begin
	fprintf !fout "\no~~~~~~~~~~~~~~~~~~~~~~~o\n(  Astrological Houses  )\n\
        o~~~~~~~~~~~~~~~~~~~~~~~o\n";
	let order = allocateHouses m d n in
	let zod = getZodiac m d n false in
    for i = 0 to 11 do print_house order zod i done  
end

let print_astro_info m d n c = begin
	fprintf !fout "
o~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~o
(  Astrological Houses Information  )
o~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~o
\n" ;
   	let order = allocateHouses m d n in
	let zod = getZodiac m d n false in
	fprintf !fout "The Ascendant is %s.\n" (List.nth zod 0) ;

	let pi = calc_index m d n in
	let pf = calc_pars_fortunae m d n in
	fprintf !fout "The Index is in House %s (%s).\n" 
		(roman_of_int  pi) (get_figure_name (List.nth order (
			if pi = 0 then 11 else pi - 1
		))) ;
	fprintf !fout "The Pars Fortunae, or Part of Fortune, is in House %s (%s).\n" 
		(roman_of_int  pf) (get_figure_name (List.nth order (
			if pf = 0 then 11 else pf - 1
		))) ;

    if !significator < 1 || !significator > 12
	then significator := 0 
	else begin
		fprintf !fout "The Significator of the Querent is %s.\n"
			(get_figure_name (List.nth order 0)) ;
		let rn = roman_of_int !significator in
		fprintf !fout "The Significator of the Quesited is %s in House %s.\n" 
			(get_figure_name (List.nth order (pred !significator))) rn ;
		fprintf !fout "The result of adding the Significators is %s.\n"
			(find_figure zodiac 
				(add (List.nth order 0) 
                    (List.nth order (!significator - 1)))).name
	end ;
	
	let company = getCompany m d n in
	let n = List.length company in
	if n = 0
	then fprintf !fout "\nThere is no company between the houses.\n"
	else begin
		fprintf !fout "\nCompany exists between" ;
        if n = 1
        then fprintf !fout " " 
        else fprintf !fout ":\n - " ;
		let withSigQt = ref [] in
		let withSigQd = ref [] in
		for i = 0 to pred n do
			let h, k, a = List.nth company i in
			let h1 = roman_of_int h in
			let h2 = roman_of_int (h + 1) in
			let f1 = List.nth order (h-1) in
			let f2 = List.nth order h in
			if f1 = List.nth order 0 
			then withSigQt := (h1, h2) :: !withSigQt ;
			if !significator > 0 && f2 = List.nth order (!significator mod 12)
			then withSigQd := (h1, h2):: !withSigQd ;		
			fprintf !fout "Houses %s and %s (%s; yields %s)\n" 
				h1 h2 k	a;
			if i < pred n && n > 1
			then fprintf !fout " - "
            else if i = 0 && n = 1
            then fprintf !fout "."
		done ;
		
		withSigQt := List.rev !withSigQt ;
		withSigQd := List.rev !withSigQd ;
		
		if !significator > 0 then begin
			if n > 1 then fprintf !fout "Of these, " else fprintf !fout "Of that, " ;
			if (List.length !withSigQt) = 0 && (List.length !withSigQd) = 0
			then begin 
				if !significator = 1 
				then fprintf !fout "the Querent's Significator is not involved"
				else fprintf !fout "neither of the Significators are involved"
			end
			else begin
				if (List.length !withSigQt) > 0
				then begin 
					fprintf !fout "the Querent's Significator is in company between Houses " ;
					for i = 0 to (pred (List.length !withSigQt)) do
						let h1, h2 = List.nth !withSigQt i in
						if i = (pred (List.length !withSigQt)) && List.length
                        !withSigQt > 1
						then fprintf !fout "and " ;
						fprintf !fout "%s and %s" h1 h2 ;
						if i < (pred (List.length !withSigQt))
						then fprintf !fout ", "
					done 
				end ;
				if (List.length !withSigQt) > 0 && (List.length !withSigQd) > 0
				then fprintf !fout "; " ;
				if (List.length !withSigQd) > 0
				then begin 
					fprintf !fout "the Quesited's Significator is in company between Houses " ;
					for i = 0 to (pred (List.length !withSigQd)) do
						let h1, h2 = List.nth !withSigQd i in
						if i = (pred (List.length !withSigQd)) && List.length
                        !withSigQd > 1
						then fprintf !fout "and " ;
						fprintf !fout "%s and %s" h1 h2 ;
						if i < (pred (List.length !withSigQd))
						then fprintf !fout ", "
					done 
				end ;
			end ;
			fprintf !fout "."
		end ;
	end ;
     
    
    if !significator > 1 then begin
            (* Initialize environment to check for modes of perfection. *)

            let figQrt = List.nth order 0 in
            let figQsd = List.nth order (pred !significator) in
            let possQrt = ref [] in
            let possQsd = ref [] in
            for i = 1 to 11 do
                if (List.nth order i) = figQrt then possQrt := i :: !possQrt
            done ; 
            for i = 1 to 11 do
                if (List.nth order i) = figQsd && i <> pred !significator
                then possQsd := i :: !possQsd
            done ;	

        
            let prft = ref [] in

            if figQrt = figQsd then prft := "occupation" :: !prft;

            if figQrt = (List.nth order (!significator mod 12)) && !significator <> 12 
            then begin
                prft := ("conjunction by the Querent to " ^ (List.nth
                aPositions (!significator + 1))) :: !prft
            end ;
            if figQrt = (List.nth order (!significator - 2)) && !significator <> 2
            then begin
                prft := ("conjunction by the Querent to " ^ (List.nth
                aPositions (!significator - 2))) :: !prft
            end ;
            if figQsd = (List.nth order 11) && !significator <> 12
            then begin
                prft := ("conjunction by the Quesited to House XII") :: !prft
            end ;
            if figQsd = (List.nth order 1) && !significator <> 2
            then begin
                prft := ("conjunction by the Quesited to House II") :: !prft
            end ;

            for i = 1 to 10 do
                let curFig = List.nth order i in
                if curFig = figQrt 
                    && i <> (!significator - 2)
                    && i <> (!significator) 
                then begin
                    let nextFig = List.nth order (i + 1) in
                    let prevFig = List.nth order (i - 1) in
                    if nextFig = figQsd
                    then begin
                        prft := ("mutation (" ^ (get_figure_name figQrt) ^
                        " passes to " ^ (List.nth aPositions i) ^ " and " ^
                        (get_figure_name figQsd) ^ " to " ^ (List.nth aPositions (i + 1)) ^
                        ")") :: !prft
                    end
                    else begin
                        if prevFig = figQsd
                        then begin
                            prft := ("mutation (" ^ (get_figure_name figQrt) ^
                            " passes to " ^ (List.nth aPositions i) ^ " and " ^
                            (get_figure_name figQsd) ^ " to " ^ (List.nth aPositions (i - 1)) ^
                            ")") :: !prft
                        end ;
                    end
                end
            done ;

            let beforeQrt = List.nth order 11 in
            let afterQrt = List.nth order 1 in
            let beforeQsd = List.nth order (!significator - 2) in
            let afterQsd = List.nth order (!significator mod 12) in
            let qrt = get_figure_name figQrt in
            let qsd = get_figure_name figQsd in
            let qrtB = get_figure_name beforeQrt in
            let qrtA = get_figure_name afterQrt in 
            let qsdB = get_figure_name beforeQsd in 
            let qsdA = get_figure_name afterQsd in 
            let qrtBB = get_figure_name (add beforeQrt figQrt) in
            let qrtAA = get_figure_name (add afterQrt figQrt) in 
            let qsdBB = get_figure_name (add beforeQsd figQsd) in 
            let qsdAA = get_figure_name (add afterQsd figQsd) in 

            if beforeQrt = beforeQsd
            then begin
                prft := ("translation between Houses XII and " ^ (List.nth aPositions
                (!significator-2))
                ^ " (" ^ qrt ^ " and " ^ qrtB ^ " yield " ^ qrtBB 
                ^ "; " ^ qsd ^ " and " ^ qsdB ^ " yield " ^ qsdBB
                ^ ")") :: !prft 
            end ;
            if beforeQrt = afterQsd && !significator <> 11
            then begin
                prft := ("translation between Houses XII and " ^ (List.nth aPositions
                (!significator mod 12))
                ^ " (" ^ qrt ^ " and " ^ qrtB ^ " yield " ^ qrtBB 
                ^ "; " ^ qsd ^ " and " ^ qsdA ^ " yield " ^ qsdAA
                ^ ")") :: !prft
            end ;
            if afterQrt = beforeQsd && !significator <> 3
            then begin
                prft := ("translation between Houses II and " ^ (List.nth aPositions
                (!significator-2)) 
                ^ " (" ^ qrt ^ " and " ^ qrtA ^ " yield " ^ qrtAA
                ^ "; " ^ qsd ^ " and " ^ qsdB ^ " yield " ^ qsdBB
                ^ ")") :: !prft
            end ;
            if afterQrt = afterQsd
            then begin
                prft := ("translation between Houses II and " ^ (List.nth aPositions
                (!significator mod 12))
                ^ " (" ^ qrt ^ " and " ^ qrtA ^ " yield " ^ qrtAA
                ^ "; " ^ qsd ^ " and " ^ qsdA ^ " yield " ^ qsdAA
                ^ ")") :: !prft
            end ;

		fprintf !fout "\n\nThe chart " ;
		begin match !prft with
		| [] 		-> fprintf !fout "is impedited.\n"
		| p :: []	-> fprintf !fout "perfects by %s.\n" p
		| _ ->	begin
					fprintf !fout "perfects in %i ways:\n" (List.length !prft) ;
					List.iter (fun p ->
						fprintf !fout " - %s\n" p
					) (List.rev !prft)
				end
        end ;
					
		(* Check for aspects: trine, sextile, square, opposition. *)
        let get_aspect i = begin
            match i with
				| 2	-> "dexter sextile"
				| 3	-> "dexter square"
				| 4	-> "dexter trine"
				| 5 -> "dexter quincunx"
				| 6	-> "opposition"
                | 7 -> "sinister quincunx"
                | 8 -> "sinister trine"
				| 9 -> "sinister square"
				| 10 -> "sinister sextile"
				| (-2)-> "sinister sextile"
				| (-3)-> "sinister square"
				| (-4)-> "sinister trine"
				| (-5)-> "sinister quincunx"
				| (-6)-> "opposition"
                | (-7)-> "dexter quincunx"
				| (-8)-> "dexter trine"
				| (-9)-> "dexter square"
				| (-10)-> "dexter sextile"
				| _ -> ""
		end in

        let psdQrtAsps = ref [] in
		for i = 1 to 11 do
		    if ((List.nth order i) = figQrt) && (i <> pred !significator)
			then begin
				let asp = get_aspect (i-(pred !significator)) in
                if asp <> ""
				then psdQrtAsps := ((List.nth aPositions i), asp) :: !psdQrtAsps ; 
            end
		done ;
		
		begin match !psdQrtAsps with
		| [] 			-> ()
		| (h, a) :: []	-> 
			begin
				fprintf !fout "\nThe Querent's Significator passing to %s make\
                s %s %s aspect to the Quesited's Significator."
					h 
					(if a = "opposition" then "an" else "a")
					a
			end
		| _ -> begin
				fprintf !fout "\nThe Querent's Significator makes %i aspects t\
                o the Quesited's Figure:" 
                    (List.length !psdQrtAsps);
				List.iter (fun t ->
					let h, a = t in
					fprintf !fout "\n - %s from %s" a h
				) !psdQrtAsps
				end
		end ;

		let psdQsdAsps = ref [] in
		for i = 2 to 11 do
            if (List.nth order i) = figQsd && i <> pred !significator
			then begin
				let asp = get_aspect i in
				if asp <> ""
				then psdQsdAsps := ((List.nth aPositions i), asp) :: !psdQsdAsps ; 
			end
		done ;
		
		begin match !psdQsdAsps with
		| [] 			-> ()
		| (h, a) :: []	-> 
			begin
				fprintf !fout "\nThe Quesited's Significator passing to %s mak\
                es %s %s to the Querent's Significator."
					h 
					(if a = "opposition" then "an" else "a")
					a
			end
		| _ -> begin
				fprintf !fout "\nThe Quesited's Significator makes %i aspects \
                to the Querent's Figure:" (List.length !psdQsdAsps);
				List.iter (fun t ->
					let h, a = t in
					fprintf !fout "\n - %s from %s" a h
				) !psdQsdAsps
				end ;
		end ;
		fprintf !fout "\n" ;
	end
end

let print_timeline m d n c = begin
	fprintf !fout "
o~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~o
(  Progression of the Cardines and Query )
o~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~o
\n";
	let order = allocateHouses m d n in
	fprintf !fout "House I  : %s\n" (get_figure_name (List.nth order 0)) ;
	fprintf !fout "House X  : %s\n" (get_figure_name (List.nth order 9)) ;
	fprintf !fout "House VII: %s\n" (get_figure_name (List.nth order 6)) ;
	fprintf !fout "House IV : %s\n" (get_figure_name (List.nth order 3)) ;
	fprintf !fout "Judge    : %s\n" (get_figure_name (List.nth c 2)) ;
	fprintf !fout "Sentence : %s\n" (get_figure_name (List.nth c 3)) ;
end

let print_dignities m d n = begin
	let order = allocateHouses m d n in
	let zod = getZodiac m d n true in
	fprintf !fout "
o~~~~~~~~~~~~~~~~~~~~~~~~~~~~o
(  Dignities of the Figures  )
o~~~~~~~~~~~~~~~~~~~~~~~~~~~~o

House   Figure           Sign    Planet        House Dignity     Sign Dignity
-----   --------------   -----   -----------   ---------------   ------------
" ;
	for i = 0 to 11 do
		let o = List.nth order i in
		let z = List.nth zod i in
		let h = roman_of_int (succ i) in
		fprintf !fout "%-8s%-17s%-8s%-14s"
			h (get_figure_name o) z (getShortPlanet o) ;
		let hRuler = getRuler o "house" (succ i) in
		let sRuler = getRuler o "sign" (succ (get_list_index zShPositions z)) in
		fprintf !fout "%-18s%s\n" hRuler sRuler
	done

end


let print_astro_tableau m d n c = begin
	let empty = [" " ; " " ; " " ; " " ; " " ; " " ; " " ; " " ; " " ; " " ; " " ; " " ] in
	let order = allocateHouses m d n in
	let zod = 
		if !displayAstroInfo then (getZodiac m d n true)
		else empty
	in 	

	let pi = ref (pred (calc_index m d n)) in
	if !pi = (-1) then pi := 11 ;
	let pf = ref (pred (calc_pars_fortunae m d n)) in
	if !pf = (-1) then pf := 11 ;
	let star i = (if i = 0 then "* *" else " * ") in
	let getStar l n = begin
		if !significator <= 1 then significator := 1 ;
		let sigf = pred !significator in
		let retr = ref "" in
		if !displayAstroInfo
		then begin
			if !displaySignfs
			then begin
			    if n = !pf
				then begin
					if (List.nth order n) = (List.nth order sigf)
					then (if l = 0 then retr := "@X X@" else retr := " @X@ ") ;
					if (List.nth order n) = (List.nth order 0)
					then (if l = 0 then retr := "@O O@" else retr := " @O@ ") ;
					if !retr = ""
					then (if l = 0 then retr := " @ @ " else retr := "  @  ")
   				end
   				else begin
   				    if n = !pi
				    then begin
					    if (List.nth order n) = (List.nth order sigf)
					    then (if l = 0 then retr := "#X X#" else retr := " #X# ") ;
					    if (List.nth order n) = (List.nth order 0)
					    then (if l = 0 then retr := "#O O#" else retr := " #O# ") ;
					    if !retr = ""
					    then (if l = 0 then retr := " # # " else retr := "  #  ")
				    end
				    else begin
					    if (List.nth order n) = (List.nth order sigf)
					    then (if l = 0 then retr := " X X " else retr := "  X  ") ;
					    if (List.nth order n) = (List.nth order 0)
					    then (if l = 0 then retr := " O O " else retr := "  O  ") ;
					    if !retr = ""
					    then (if l = 0 then retr := " * * " else retr := "  *  ")
				    end
				end
			end
			else begin
			    if n = !pf
				then (if l = 0 then retr := " @ @ " else retr := "  @  ")
				else if n = !pi
				    then (if l = 0 then retr := " # # " else retr := "  #  ")
				    else (if l = 0 then retr := " * * " else retr := "  *  ")
			end		
		end
		else (if l = 0 then retr := " * * " else retr := "  *  ") ;
		!retr
	end
	in


	fprintf !fout "\no~~~~~~~~~~~~~~~~~~~~~~o\n(  Astrological Chart  )\n\
        o~~~~~~~~~~~~~~~~~~~~~~o\n\n" ;


fprintf !fout "o-----------+-----------+-----------+-----------o
|XI      %3s|X       %3s|IX      %3s|VIII    %3s|
|" (List.nth zod 10) (List.nth zod 9) (List.nth zod 8) (List.nth zod 7) ;

	for i = 10 downto 7 do
		let f = List.nth order i in
		let str = getStar f.head i in
		fprintf !fout "   %s   |"  str ;
	done ;
	fprintf !fout "\n|" ;
	for i = 10 downto 7 do
		let f = List.nth order i in
		let str = getStar f.neck i in
		fprintf !fout "   %s   |"  str ;
	done ;
	fprintf !fout "\n|" ;
	for i = 10 downto 7 do
		let f = List.nth order i in
		let str = getStar f.body i in
		fprintf !fout "   %s   |"  str ;
	done ;
	fprintf !fout "\n|" ;
	for i = 10 downto 7 do
		let f = List.nth order i in
		let str = getStar f.feet i in
		fprintf !fout "   %s   |"  str ;
	done ;
	fprintf !fout "\n|" ;
	
	for i = 10 downto 7 do
		let f = List.nth order i in
		let pn = getShortPlanet f in
		fprintf !fout "%-11s|" (if !displayAstroInfo then pn else " ") ;
	done ;
	
	fprintf !fout "\n+-----------+-----------+-----------+-----------+
|XII     %3s|                       |VII     %3s|
|" (List.nth zod 11) (List.nth zod 6) ;

	if not !displayAstroCourt
	then begin
		fprintf !fout "   %s   |                       |   %s   |\n|"
			(getStar (List.nth order 11).head 11) 
			(getStar (List.nth order 6).head 6) ;
		fprintf !fout "   %s   |                       |   %s   |\n|"
			(getStar (List.nth order 11).neck 11) 
			(getStar (List.nth order 6).neck 6) ;
		fprintf !fout "   %s   |                       |   %s   |\n|"
			(getStar (List.nth order 11).body 11) 
			(getStar (List.nth order 6).body 6) ;
		fprintf !fout "   %s   |                       |   %s   |\n|"
			(getStar (List.nth order 11).feet 11) 
			(getStar (List.nth order 6).feet 6)
	end
	else begin          
		fprintf !fout "   %s   |    %s         %s    |   %s   |\n|"
			(getStar (List.nth order 11).head 11) 	
			(star (List.nth c 1).head)
			(star (List.nth c 0).head)
			(getStar (List.nth order 6).head 6) ;
		fprintf !fout "   %s   |    %s         %s    |   %s   |\n|"
			(getStar (List.nth order 11).neck 11) 
			(star (List.nth c 1).neck)
			(star (List.nth c 0).neck)
			(getStar (List.nth order 6).neck 6) ;
		fprintf !fout "   %s   |    %s         %s    |   %s   |\n|"
			(getStar (List.nth order 11).body 11) 
			(star (List.nth c 1).body)
			(star (List.nth c 0).body)
			(getStar (List.nth order 6).body 6) ;
		fprintf !fout "   %s   |    %s         %s    |   %s   |\n|"
			(getStar (List.nth order 11).feet 11) 
			(star (List.nth c 1).feet)
			(star (List.nth c 0).feet)
			(getStar (List.nth order 6).feet 6)


	end ;
		
	let pn12, pn7 = if !displayAstroInfo 
		then (getShortPlanet (List.nth order 11)), getShortPlanet (List.nth order 6)
		else " ", " "
	in
	fprintf !fout "%-11s|                       |%-11s|" pn12 pn7 ;
	
	fprintf !fout "\n+-----------+                       +-----------+
|I       %3s|                       |VI      %3s|
|" (List.nth zod 0) (List.nth zod 5) ;

	if !displayAstroCourt 
	then begin
		fprintf !fout "   %s   |          %s          |   %s   |\n|"
			(getStar (List.nth order 0).head 0) 
			(star (List.nth c 2).head)
			(getStar (List.nth order 5).head 5) ;
		fprintf !fout "   %s   |          %s          |   %s   |\n|"
			(getStar (List.nth order 0).neck 0) 
			(star (List.nth c 2).neck)
			(getStar (List.nth order 5).neck 5) ;
		fprintf !fout "   %s   |          %s          |   %s   |\n|"
			(getStar (List.nth order 0).body 0) 
			(star (List.nth c 2).body)
			(getStar (List.nth order 5).body 5) ;
		fprintf !fout "   %s   |          %s          |   %s   |\n|"
			(getStar (List.nth order 0).feet 0) 
			(star (List.nth c 2).feet)
			(getStar (List.nth order 5).feet 5) ;
	end
	else begin
		fprintf !fout "   %s   |                       |   %s   |\n|"
			(getStar (List.nth order 0).head 0) 
			(getStar (List.nth order 5).head 5) ;
		fprintf !fout "   %s   |                       |   %s   |\n|"
			(getStar (List.nth order 0).neck 0) 
			(getStar (List.nth order 5).neck 5) ;
		fprintf !fout "   %s   |                       |   %s   |\n|"
			(getStar (List.nth order 0).body 0) 
			(getStar (List.nth order 5).body 5) ;
		fprintf !fout "   %s   |                       |   %s   |\n|"
			(getStar (List.nth order 0).feet 0) 
			(getStar (List.nth order 5).feet 5) ;
	end ;
	
	let pn1, pn5 = if !displayAstroInfo 
		then (getShortPlanet (List.nth order 0)), getShortPlanet (List.nth order 5)
		else " ", " "
	in
	fprintf !fout "%-11s|                       |%-11s|" pn1 pn5 ;
	
	fprintf !fout "
+-----------+-----------+-----------+-----------+
|II      %3s|III     %3s|IV      %3s|V       %3s|
|" (List.nth zod 1) (List.nth zod 2) (List.nth zod 3) (List.nth zod 4) ;

	for i = 1 to 4 do
		let f = List.nth order i in
		let str = getStar f.head i in
		fprintf !fout "   %s   |"  str ;
	done ;
	fprintf !fout "\n|" ;
	for i = 1 to 4 do
		let f = List.nth order i in
		let str = getStar f.neck i in
		fprintf !fout "   %s   |"  str ;
	done ;
	fprintf !fout "\n|" ;
	for i = 1 to 4 do
		let f = List.nth order i in
		let str = getStar f.body i in
		fprintf !fout "   %s   |"  str ;
	done ;
	fprintf !fout "\n|" ;
	for i = 1 to 4 do
		let f = List.nth order i in
		let str = getStar f.feet i in
		fprintf !fout "   %s   |"  str ;
	done ;
	fprintf !fout "\n|" ;
	
	for i = 1 to 4 do
		let f = List.nth order i in
		let pn = getShortPlanet f in
		fprintf !fout "%-11s|" (if !displayAstroInfo then pn else " ") ;
	done ;
	fprintf !fout "\no-----------+-----------+-----------+-----------o" ;
end

let get_settings_string () = begin
	let sets = ref "" in
    if !showSettings then begin
        sets := "------------------------------------------------------------\
            -------------------\nSettings used: " ;
        begin match !zodiacSystem with
		| "gerard"	-> sets := !sets ^ 
            "Used Gerard of Cremona's assignment to find the Ascendant.\n"
		| "agrippa"	-> sets := !sets ^
            "Used Cornelius Agrippa's assignment to find the Ascendant.\n"
		| "aries"	-> sets := !sets ^
            "Assigned Aries as a default to the Ascendant.\n" 
		| _ -> raise OH_NOES end ;

		begin match !houseSystem with
		| "trad"-> sets := !sets ^ 
            "Used the traditional house allocation system.\n"
		| "eso"	-> sets := !sets ^ 
            "Used the esoteric house allocation system.\n"
		| "gd"	-> sets := !sets ^ 
            "Used the Golden Dawn house allocation system.\n"
		| _ -> raise OH_NOES end ;
	
		begin match !significator with
		| 1 -> sets := !sets ^ 
            "Only inspected the Significator of the Querent from House I.\n"
		| 2 -> sets := !sets ^ 
            "Designated House II as the Significator of the Quesited.\n"
		| 3 -> sets := !sets ^ 
            "Designated House III as the Significator of the Quesited.\n"
		| 4 -> sets := !sets ^ 
            "Designated House IV as the Significator of the Quesited.\n"
		| 5 -> sets := !sets ^ 
            "Designated House V as the Significator of the Quesited.\n"
		| 6 -> sets := !sets ^ 
            "Designated House VI as the Significator of the Quesited.\n"
		| 7 -> sets := !sets ^ 
            "Designated House VII as the Significator of the Quesited.\n"
		| 8 -> sets := !sets ^ 
            "Designated House VIII as the Significator of the Quesited.\n"
		| 9 -> sets := !sets ^ 
            "Designated House IX as the Significator of the Quesited.\n"
		| 10 -> sets := !sets ^ 
            "Designated House X as the Significator of the Quesited.\n"
		| 11 -> sets := !sets ^ 
            "Designated House XI as the Significator of the Quesited.\n"
		| 12 -> sets := !sets ^ 
            "Designated House XII as the Significator of the Quesited.\n"
		| _ -> sets := !sets ^ "Did not assign significators.\n" end ;
		
		begin match !rotation with
		| 2 -> sets := !sets ^ 
            "Rotated the chart to use House II as the Ascendant.\n"
		| 3 -> sets := !sets ^ 
            "Rotated the chart to use House III as the Ascendant.\n"
		| 4 -> sets := !sets ^ 
            "Rotated the chart to use House IV as the Ascendant.\n"
		| 5 -> sets := !sets ^ 
            "Rotated the chart to use House V as the Ascendant.\n"
		| 6 -> sets := !sets ^ 
            "Rotated the chart to use House VI as the Ascendant.\n"
		| 7 -> sets := !sets ^ 
            "Rotated the chart to use House VII as the Ascendant.\n"
		| 8 -> sets := !sets ^ 
            "Rotated the chart to use House VIII as the Ascendant.\n"
		| 9 -> sets := !sets ^ 
            "Rotated the chart to use House IX as the Ascendant.\n"
		| 10 -> sets := !sets ^ 
            "Rotated the chart to use House X as the Ascendant.\n"
		| 11 -> sets := !sets ^ 
            "Rotated the chart to use House XI as the Ascendant.\n"
		| 12 -> sets := !sets ^ 
            "Rotated the chart to use House XII as the Ascendant.\n"
		| _ -> sets := !sets ^ "Did not rotate the chart.\n" end ;
	end ;
    !sets
end

let print_gc_output m d n c all = begin
        let company = getCompany m d n in
    	let order = allocateHouses m d n in
    	let zod = getZodiac m d n false in

        fprintf !fout "\n" ;
	    print_gcpo_chart m d n c ;
        fprintf !fout "\n" ;
        
        print_via_puncti m d n c ;
        fprintf !fout "  The sum of the points is %i.  \
          The Index is in house %i.  The Pars Fortunae is in house %i."
          (get_sum all) (calc_index m d n) (calc_pars_fortunae m d n) ;
        
        if !significator > 1 then begin
            fprintf !fout "  The quesited's significator is %s in house %i." 
              (get_figure_name (List.nth order (!significator - 1))) !significator ;
        end ; 
        
        (* modes of perfection *)
        (* The chart can only perfect if there's a valid significator!*)
        if !significator > 1 then begin
            (* Initialize environment to check for modes of perfection. *)
            let figQrt = List.nth order 0 in
            let figQsd = List.nth order (pred !significator) in
            let possQrt = ref [] in
            let possQsd = ref [] in
            for i = 1 to 11 do
                if (List.nth order i) = figQrt then possQrt := i :: !possQrt
            done ; 
            for i = 1 to 11 do
                if (List.nth order i) = figQsd && i <> pred !significator
                then possQsd := i :: !possQsd
            done ;	
            
            let prft = ref [] in
            if figQrt = figQsd then prft := "occupation" :: !prft;

            if figQrt = (List.nth order (!significator mod 12)) && !significator <> 12 
            then begin
                prft := ("conjunction by the Querent to house" ^ (string_of_int
                !significator)) :: !prft
            end ;
            if figQrt = (List.nth order (!significator - 2)) && !significator <> 2
            then begin
                prft := ("conjunction by the Querent to house" ^ (string_of_int
                (!significator - 2))) :: !prft
            end ;
            if figQsd = (List.nth order 11) && !significator <> 12
            then begin
                prft := ("conjunction by the Quesited to house 12") :: !prft
            end ;
            if figQsd = (List.nth order 1) && !significator <> 2
            then begin
                prft := ("conjunction by the Quesited to house 2") :: !prft
            end ;

            for i = 1 to 10 do
                let curFig = List.nth order i in
                if curFig = figQrt 
                    && i <> (!significator - 2)
                    && i <> (!significator) 
                then begin
                    let nextFig = List.nth order (i + 1) in
                    let prevFig = List.nth order (i - 1) in
                    if nextFig = figQsd
                    then begin
                        prft := ("mutation (" ^ (get_figure_name figQrt) ^
                        " passes to " ^ (List.nth aPositions i) ^ " and " ^
                        (get_figure_name figQsd) ^ " to " ^ (List.nth aPositions (i + 1)) ^
                        ")") :: !prft
                    end
                    else begin
                        if prevFig = figQsd
                        then begin
                            prft := ("mutation (" ^ (get_figure_name figQrt) ^
                            " passes to " ^ (List.nth aPositions i) ^ " and " ^
                            (get_figure_name figQsd) ^ " to " ^ (List.nth aPositions (i - 1)) ^
                            ")") :: !prft
                        end ;
                    end
                end
            done ;
        
            let beforeQrt = List.nth order 11 in
            let afterQrt = List.nth order 1 in
            let beforeQsd = List.nth order (!significator - 2) in
            let afterQsd = List.nth order (!significator mod 12) in
            
            if beforeQrt = beforeQsd
            then begin
                prft := ("translation (" ^ (get_figure_name beforeQrt) ^
                " passes between houses 12 and " ^ (string_of_int
                (!significator-1)) ^ ")") :: !prft 
            end ;
            if beforeQrt = afterQsd && !significator <> 11
            then begin
                prft := ("translation (" ^ (get_figure_name beforeQrt) ^
                " passes between houses 12 and " ^ (string_of_int !significator)
                ^ ")") :: !prft
            end ;
            if afterQrt = beforeQsd && !significator <> 3
            then begin
                prft := ("translation (" ^ (get_figure_name afterQrt) ^
                " passes between houses 2 and " ^ (string_of_int (!significator-1))
                ^ ")") :: !prft
            end ;
            if afterQrt = afterQsd
            then begin
                prft := ("translation (" ^ (get_figure_name afterQrt) ^
                " passes between houses 2 and " ^ (string_of_int !significator)
                ^ ")") :: !prft
            end ;

            fprintf !fout "  The chart " ;
            begin match !prft with
            | [] 		-> fprintf !fout "is impedited."
            | p :: []	-> fprintf !fout "perfects by %s." p
            | _ ->	begin
                        let l = List.length !prft in
                        fprintf !fout "perfects by " ;
                        for i = 0 to pred l do
                            let p = List.nth (List.rev !prft) i in
                            fprintf !fout "%s" p ;
                            if i = pred l then fprintf !fout "." ;
                            if i < pred l && i > 0 then fprintf !fout ", " ;
                            if i = pred (pred l) then fprintf !fout " and " ;
                        done
                    end
            end ;
        end;

	    let l = List.length company in
	    if l = 0
    	then fprintf !fout "  No company between the houses."
    	else begin
    		fprintf !fout "  Company exists between houses " ;
		    for i = 0 to pred l do
			    let h, k, a = List.nth company i in
			    fprintf !fout "%i and %i" 
				    h (h + 1);
			    if i < pred l
			    then fprintf !fout ", " ;
			    if i = pred (pred l) && i > 0
			    then fprintf !fout "and " ;
			    if i = pred l
			    then fprintf !fout "." ;
		    done ;
		end ;
	
        fprintf !fout "  The Ascendant is %s.\n" (List.nth zod 0) ;        
    end

let set_display_everything () = begin
	displayAstro := true ; displayAstroInfo := true ;
	displayTimeline := true ; displayGeo := true ;
	displayGeoInfo := true ; displayGeoTriads := true ;
	displayMoreTriads := true ; displayRulerships := true ;
	displayAstroCourt := true ; displayAstroTableau := true ;
	displayGeoTableau := true ; showSettings := true ;
	displaySignfs := true ; displayGeoTableauFull := true ;
end

let prompt_settings () = begin
    let rec getSetting question setting = begin
		printf "%s (y/n): " question ;
		let c = read_line () in
		if c = "y" 
		then setting := true
		else (if c = "n" 
			then setting := false 
			else (printf "Bad input!  Please try again.\n" ; 
				getSetting question setting)
		)
	end in
	let rec getSettingSelect question setting choices default = begin
		printf "%s (" question ;
		for i = 0 to pred (List.length choices) do
			printf "%s" (List.nth choices i) ;
			if i < pred (List.length choices)
			then printf ", "
			else printf "): "
		done ;
		
		let c = read_line () in
		try
			setting := List.find (fun f -> f = c) choices
		with _ -> setting := default
	end in
	let rec getSettingInt question setting default = begin
		printf "%s: " question ;
		let c = read_line () in
		try
			setting := int_of_string c ;
		with _ -> setting := default 
	end in

    let saveYN = ref false in
	getSetting "Save output to file?" saveYN ;
	if !saveYN
	then begin
        printf "Enter the name of the file, or enter to use default: " ;
        let name = begin
            let s = read_line () in
            if s = "" 
            then "reading.txt"
            else (s ^ ".txt")
        end in
	    printf "Output will be saved to file \"%s\".\n" name ;
        saveFile := name ;
    end;

	getSetting "Get querent's info?" getQuerentInfo ;
	getSetting "Compute and show everything?" showEverything ;
	
    if !showEverything 
    then set_display_everything ()
	else getSetting "Compute and display abbreviated output?" gcpo ;
	
    getSetting "Enter the Mothers as names (not binary strings)?" verbalInput ;
	if not !showEverything 
    then begin
		getSetting "Display geomantic tableau table?" displayGeo ;
		getSetting "Display geomantic tableau chart?" displayGeoTableau ;
		if !displayGeoTableau
        then getSetting "Display the extended geomantic tableau?" displayGeoTableauFull ;
	    if !displayGeo 
        then begin
			getSetting "Display extended geomantic tableau information?" displayGeoInfo ;
			getSetting "Display triads?" displayGeoTriads ;
			if !displayGeoTriads 
            then begin 
				getSetting "Display minor triads?" displayMoreTriads ;
			    getSetting "Display triads as a process of evolution?" evolveTriads
			end 
        end ;
		
        getSetting "Display astrological geomancy table?" displayAstro ;
		getSetting "Display astrological geomancy chart?" displayAstroTableau ;
		if !displayAstroTableau
        then getSetting "Display the Court in the astrological chart?" displayAstroCourt ;
		if !displayAstro 
        then begin
			getSetting "Display extended astrological information?" displayAstroInfo ; 
			getSetting "Display dignities of the figures?" displayRulerships ; 
			getSetting "Display the Progression of the Cardines?" displayTimeline ; 
			getSetting "Display settings at the conclusion of the reading?" showSettings
		end
	end	;
	if !displayAstro || !displayAstroTableau 
    then begin			
		getSettingInt 
            "Use significators?  (pick the house of the quesited, or 0 for none)" 
            significator 0;
		if !significator <> 0 
		then displaySignfs := true 
        else displaySignfs := false ;
		getSettingSelect 
            "Choose a house allocation system (default is \"trad\")." 
            houseSystem ["trad" ; "eso" ; "gd"] "trad";
		getSettingSelect 
            "Choose an ascendant allocation system (default is \"gerard\")." 
            zodiacSystem ["gerard" ; "agrippa" ; "aries"] "gerard" ;
		getSettingInt "Rotate to a particular house? (0 or 1 for no rotation)" rotation 0;
	end ;
	printf "\n" ;
end

let get_querent_info () = 
    if !getQuerentInfo
        then begin
            printf "Enter the querent's name: " ;
            let n = read_line () in
            printf "Enter the date and time of the query: " ;
            let d = read_line () in
            printf "Enter the query: " ;
            let q = read_line () in 
            printf "\n" ;
            n, d, q
        end
    else "", "", ""	

(**********************
 * The main function. *
 **********************)
let main () = begin
	let usageMsg = "Geomancian - produces geomantic tableaux and house arrangments" in
	let version = "1.2" in
	
	let argDescr = [
		"--version", Arg.Set showVersion, 
        " show name and version of Geomancian" ;
        "--save", Arg.Set_string saveFile, 
        "X save all output into a new file X" ;
		"--querent", Arg.Set getQuerentInfo, 
        " get querent information, including query" ;
		"--noprompt", Arg.Clear promptInputs, 
        " do not prompt for settings in the program (enter using command line)" ;
		"--verbal", Arg.Set verbalInput, 
        " enter mothers verbally" ;
		"--settings", Arg.Set showSettings, 
        " show particular settings in calculations" ;
		"--charts", Arg.Clear showBothCharts, 
        "display tableau and astrological chart in ASCII" ;
		"--showall", Arg.Set showEverything, 
        " display all available information and charts" ;
		"--gcpo", Arg.Set gcpo, 
        " abbreviated output for mailing lists and emails\n\n\
        Geomantic Tableau Options" ;
		"--nogeo", Arg.Clear displayGeo, 
        " do not display geomantic tableau" ;
		"--geoinfo", Arg.Set displayGeoInfo, 
        " display extra geomantic tableau information" ;	
		"--geochart", Arg.Set displayGeoTableau, 
        " display geomantic tableau in ASCII" ;
		"--geochart-full", Arg.Set displayGeoTableauFull, 
        " display entire geomantic tableau (including Via Puncti and Index)" ;
		"--triads", Arg.Set displayGeoTriads, 
        " display triad information in geomantic chart" ;
		"--triads-more", Arg.Set displayMoreTriads, 
        " display extra triads information in geomantic chart" ;
		"--triads-alt", Arg.Set evolveTriads, 
        " display triads as RightParent -> Child -> LeftParent\n\n\
        Astrological Tableau Options" ;		
		"--astro", Arg.Set displayAstro, 
        " display astrological chart information" ;
		"--astroinfo", Arg.Set displayAstroInfo, 
        " display extra astrological chart information" ; 
		"--astrochart", Arg.Set displayAstroTableau, 
        " display astrological chart in ASCII" ;
		"--timeline", Arg.Set displayTimeline, 
        " display the Progression of the Cardines with the Judge and Sentence" ;
		"--dignities", Arg.Set displayRulerships, 
        " display the dignities of the figures by sign and house" ;
		"--astro-court", Arg.Set displayAstroCourt, 
        " display the Witnesses and Judge in the astrological chart" ;
		"--ascendant", Arg.Set_string zodiacSystem, 
        "X use a particular sign system (default is \"gerard\"):\
        gerard, agrippa, aries" ;
		"--house", Arg.Set_string houseSystem, 
        "X use a particular house system (default is \"trad\"):\
        trad, eso, gd" ;
		"--quesited", Arg.Set_int significator, 
        "X set the house of the quesited's significator" ;
		"--sigs", Arg.Set displaySignfs, 
        " show the significators in the astrological chart" ;
		"--rotate", Arg.Set_int rotation, 
        "X rotate the houses to allow for a third-party querent significator\n" ;
	] in
	try begin
        Arg.parse (Arg.align argDescr) (fun a -> ()) usageMsg ;
        
        if !showVersion then printf "%s %s\n" usageMsg version
        else begin

        printf "\n-----------------------------------------------------------\
        --------------------\n\
        %s\n\
        Version %s, Copyright (C) 2009 Sam Block\n\n\
        This program comes with ABSOLUTELY NO WARRANTY.  This program is free \
        software,\n\
        and you are welcome to redistribute it under certain conditions; pleas\
        e see the\n\
        included copy of the GNU Public License for details.\n\
        ---------------------------------------------------------------------\
        ----------\n\n" usageMsg version ;
        
        if !showEverything then set_display_everything () ;
        if !promptInputs then prompt_settings () ;
        if !showBothCharts then (displayGeoTableau := true ; displayAstroTableau := true) ;

        let qname, qdate, qquery = get_querent_info () in

        if (String.length !saveFile) <> 0
        then fout := open_out !saveFile ;
        
        let m1, m2, m3, m4 = form_mothers () in
        let d1, d2, d3, d4 = form_daughters m1 m2 m3 m4 in
        let n1, n2, n3, n4 = form_nieces m1 m2 m3 m4 d1 d2 d3 d4 in
        let rw, lw, j, s = form_court n1 n2 n3 n4 m1 in
        
        let m = [ m1 ; m2 ; m3 ; m4 ] in
        let d = [ d1 ; d2 ; d3 ; d4 ] in
        let n = [ n1 ; n2 ; n3 ; n4 ] in
        let c = [ rw ; lw ; j ; s ] in	
        let all = List.concat [ m ; d ; n ; c ] in
        
        build_dignity_table () ;
        
        if !saveFile <> ""
        then fprintf !fout 
                "----------------------------------------------\n\
                 This file produced by Geomancian, version %s.\n\
                 Copyright (c) 2009 by Sam Block.\n\
                 ----------------------------------------------\n" version ;

        if !gcpo
        then print_gc_output m d n c all
        else begin
            if !getQuerentInfo
            then begin
                fprintf !fout 
                    " __________________________\n\
                    ($~~~~~~~~~~~~~~~~~~~~~~~~$)\n\
                    (| Querent's Information  |)\n\
                    ($~~~~~~~~~~~~~~~~~~~~~~~~$)\n\
                    |TTTTTTTTTTTTTTTTTTTTTTTTTT|\n\n" ;
                fprintf !fout "Name of the Querent: %s\n" qname ;
                fprintf !fout "Date of the Query  : %s\n" qdate ;
                fprintf !fout "Query: %s\n" qquery
            end ;
            
            if !displayGeo 
            then begin
                print_geo_chart m d n c ; 
                if !displayGeoInfo then print_geo_info m d n c all  ;
                if !displayGeoTriads then print_triads m d n c ;
            end ;

            if !displayGeoTableau then print_geo_tableau m d n c ;
            
            if !displayAstro 
            then begin 
                print_astro_chart m d n ;
                if !displayAstroInfo then print_astro_info m d n c ; 
                if !displayRulerships then print_dignities m d n ;
                if !displayTimeline then print_timeline m d n c ;
            end ;
            
            if !displayAstroTableau then print_astro_tableau m d n c ;

            let sets = get_settings_string () in
            fprintf !fout "\n\n%s\
                --------------------------------------------------------------\
                -----------------
                        Calculations and display complete
                    Thank you for geomancing with Geomancian!\n\
                --------------------------------------------------------------\
                -----------------\n\n" 
                (if String.length sets > 0 then sets else "");	
        
            if (not (Sys.os_type = "Unix")) && !saveFile = ""
            then begin
                printf "\nPress return to exit.\n\n" ;
                ignore (read_line ())
            end
            else close_out !fout;
            end ;
            exit 0
        end
    end
	with Bad_Input -> fprintf !fout "\n!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\
        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n\
         CRASH WARNING - CRASH WARNING - CRASH WARNING - CRASH WARNING - CRASH \
         WARNING\n\
        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\
        !!!!!!!!!
    Bad input caused the program to crash.  Please submit a bug report to
    \"sjb4g <at> virginia <spot> edu\" with the header name \"Geomancian\",
    your exact input, what happened, and the output.\n\
        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\
        !!!!!!!!!\n" ; exit 1
	| OH_NOES -> fprintf !fout "\n!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\
        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n\
         CRASH WARNING - CRASH WARNING - CRASH WARNING - CRASH WARNING - CRASH \
         WARNING\n\
        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\
        !!!!!!!!!
    Something went horribly wrong with the program logic, making it crash.  
    Please submit a bug report to \"sjb4g <at> virginia <spot> edu\" with the 
    header name \"Geomancian\", your exact input, what happened, and the
    output.\
        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\
        !!!!!!!!!\n" ; exit 2
	| _ -> fprintf !fout "\n!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\
        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n\
        CRASH WARNING - CRASH WARNING - CRASH WARNING - CRASH WARNING - CRASH W\
        ARNING\n\
        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\
        !!!!!!!!!
    An outside function didn't work right, messing up the program and making it
    crash.  Please submit a bug report to \"sjb4g <at> virginia <spot> edu\" 
    with the header name \"Geomancian\", your exact input, what happened, and 
    the output.\n\
        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\
        !!!!!!!!!\n" ; exit 3
end ;;
main ()
